perm filename SAMB.F4[SAM,LCS] blob
sn#437747 filedate 1979-04-27 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 CGEN1 FUNCTION GENERATOR 1 (SEG) *** SAM 5 ***
C00009 ENDMK
Cā;
CGEN1 FUNCTION GENERATOR 1 (SEG) *** SAM 5 ***
SUBROUTINEGEN1
COMMON I(1)/P/ P(1) /GENS/GENS(1)
1 /LFUNC/LFUNC
EQUIVALENCE (K,I)
K=K-1
N1=1+(IFIX(P(4))-1)*LFUNC
GENS(N1)=999
C FLAG FOR SEG FUNC.
N1=N1+1
JJ=5
102 GENS(N1)=P(JJ+2)-P(JJ)
C AMPL. CHANGE TO NEXT POINT
GENS(N1+1)=(P(JJ+3)-1)/99.0
C SINCE FIRST STEP IS 1 AND LAST IS 100.
CC GENS(N1+1)=(P(JJ+3)-P(JJ+1))/512.
C % OF TIME ON THIS SLOPE
JJ=JJ+2
N1=N1+2
IF(JJ.LT.K)GO TO 102
GENS(N1)=999
C TERMINATION FLAG=999
RETURN
END
CGEN2 FUNCTION GENERATOR 2 (SYNTH) *** SAM 5 ***
SUBROUTINEGEN2
COMMON I(1)/P/ P(1) /GENS/GENS(1)
1 /LFUNC/LFUNC
EQUIVALENCE (K,I)
N1=1+(IFIX(P(4))-1)*LFUNC
JJ=5
102 GENS(N1)=P(JJ)
C AMPL. OF THIS HARMONIC
JJ=JJ+1
N1=N1+1
IF(JJ.LT.K)GO TO 102
GENS(N1)=999
RETURN
END
SUBROUTINE SAMOUT(IDSK,N)
COMMON I(1) /ROUT/ROUT(1) /FINOUT/JPEAK,IPEAK,NBUF
1 /CONV/ICONV,INIOUT,JFLNM
COMMON /DEVS/ID1,ID21,JTYPE,ID23,KOUT
DATA TEST/'TEST'/
DIMENSION IDBUF(2048),JDBUF(512),NN(512),LDBUF(512)
EQUIVALENCE (IDBUF,JDBUF),(LDBUF,IDBUF(513))
C*** IDBUF WILL STORE PACKED SAMPLES. ****
IF(ICONV.EQ.0)GO TO 2
CALL SAMO2(IDSK,N)
C THIS IS FOR INTERACTIVE USE.
RETURN
2 IF(INIOUT.EQ.0)GO TO 99
C NOW OPEN PROPER OUTPUT FILE
INIOUT=0
IDSK=0
CALL DISKO(ID23,TEST,2)
C 2=UNFORMATTED OUTPUT
C OUTPUT IS ALWAYS NAMED 'TEST.DAT' FOR NOW.
99 J=IDSK+1
M1=1
M2=0
IDSK=IDSK+N
C COUNTS SAMPLES TO DATE
DO 1 K=J,IDSK
IS=ROUT(M1+M2)
IA=IABS(IS)
IF(IA.GT.IPEAK)IPEAK=IA
IDBUF(K)=IS
1 M2=M2+1
IF(IDSK.LT.NBUF)RETURN
C NBUF=512,MONO =1024,STEREO
11 WRITE(ID23)JDBUF
IF(NBUF.NE.512)WRITE(ID23),LDBUF
C ABOVE FOR STEREO
10 J=IDSK-NBUF
IF(J.LT.1)GO TO 4
DO 5 K=1,J
5 IDBUF(K)=IDBUF(NBUF+K)
4 IDSK=J
RETURN
END
CERRO1 GENERAL ERROR ROUTINE *** MUSIC V ***
SUBROUTINE ERROR(I)
COMMON /DEVS/ID1,ID21,JTYPE,ID23,KOUT
WRITE(JTYPE,100),I
100 FORMAT (' ERROR OF TYPE',I5/)
RETURN
END